home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1998 November: Tool Chest / Dev.CD Nov 98 TC.toast / Sample Code / Overview / Signals / PTestSignal.p < prev    next >
Encoding:
Text File  |  1994-11-18  |  3.1 KB  |  138 lines  |  [TEXT/MPS ]
  1. {------------------------------------------------------------------------------
  2. #
  3. #    Apple Macintosh Developer Technical Support
  4. #
  5. #    Exception handling for MPW Pascal, MacApp and MPW C
  6. #
  7. #    UFailure (aka Signals) - “Exceptional code, with a few exceptions.”
  8. #
  9. #    PTestSignal.p    -    Test tool for Pascal access to enhanced UFailure
  10. #
  11. #    Copyright © 1985-1988 Apple Computer, Inc.
  12. #    All rights reserved.
  13. #
  14. #    Versions:    1.00                11/88
  15. #                1.01                06/92
  16. #
  17. #    Components:    CTestSignal.c        November 1, 1988
  18. #                CTestSignal.make    November 1, 1988
  19. #                PTestSignal.p        November 1, 1988
  20. #                PTestSignal.make    November 1, 1988
  21. #                UFailure.p            November 1, 1988
  22. #                UFailure.h            November 1, 1988
  23. #                UFailure.incl.p        November 1, 1988
  24. #                UFailure.a            November 1, 1988
  25. #
  26. #    UFailure (or Signals) is a set of exception handling routines suitable for
  27. #    use with MacApp, MPW C, and MPW Pascal. It is a jazzed-up version of the MacApp
  28. #    UFailure unit. There is a set of C interfaces to it as well.
  29. #
  30. ------------------------------------------------------------------------------}
  31.  
  32. Program TestSignals;
  33.  
  34. USES
  35.     Types, QuickDraw, Events, Controls, Windows, TextEdit, Dialogs, Fonts, Lists,
  36.     Menus, Resources, Scrap, ToolUtils, 
  37.     OSUtils, Files, Devices, DeskBus, DiskInit, Disks, Errors, Memory, Retrace, SegLoad, Serial,
  38.     ShutDown, Slots, Sound, Start, Timer, Packages,
  39.     UFailure;
  40. {$D+}
  41.  
  42.  
  43. PROCEDURE DoCatchOutMain(s:STRING; long:LONGINT);
  44. BEGIN
  45.     Writeln(s, long:2);
  46.     Exit(TestSignals);
  47. END; {DoCatchOutMain}
  48.  
  49.         
  50.  
  51.  
  52. FUNCTION Value:LONGINT;
  53.     VAR
  54.         code:    INTEGER;
  55.         
  56.     PROCEDURE Never;
  57.         VAR
  58.             code:    INTEGER;
  59.             fi:        FailInfo;
  60.     
  61.         PROCEDURE Handler(code: INTEGER; message: LONGINT);
  62.             BEGIN
  63.                 Writeln('Handler from Never; message = ',message:2,', code = ',code:2);
  64.                 {this will do an implicit Failure() when it exits}
  65.             END;
  66.  
  67.         BEGIN {Never}
  68.             CatchFailures(fi, Handler);
  69.     
  70.             code := CatchSignal;
  71.             IF code <> 0 THEN BEGIN
  72.                 Writeln('Never shouldn’t get here; code=', code:2);
  73.                 Value := code;
  74.                 Exit(Never);
  75.             END;
  76.         
  77.             FreeSignal; {"free" the last CatchSignal}
  78.             
  79.             SignalMessage(7, 77777); {Signal a 7 to the last Catch (in this case}
  80.         END;{Never}
  81.  
  82.  
  83.     PROCEDURE Failer;
  84.         BEGIN
  85.             IF CatchSignal = 0 THEN
  86.                 Never;
  87.             
  88.             Failure(69, 0);            {fail no matter what}
  89.         END; {Failer}
  90.         
  91.     BEGIN {Value}
  92.         code := CatchSignal;
  93.         IF code <> 0 THEN BEGIN
  94.             Writeln('Shouldn’t be here in Value, code=', code:2);
  95.             Value := code;
  96.             Exit(Value);
  97.         END;
  98.         
  99.         {when this does its return the CatchSignal above will be automatically popped}
  100.         code := CatchSignal;
  101.         IF code <> 0 THEN BEGIN
  102.             Value := code;
  103.             Exit(Value);
  104.         END;
  105.         
  106.         Failer;
  107.     END;{Value}
  108.  
  109. PROCEDURE Main;
  110.     
  111.     VAR
  112.         aString:        Str255;
  113.         code:            INTEGER;
  114.         registerLong:    LONGINT;
  115.  
  116.     BEGIN
  117.  
  118.         registerLong := 0;
  119.         
  120.         {catch Signals not otherwise caught by the program}
  121.         code := CatchSignal;
  122.         IF code <> 0 THEN BEGIN
  123.             NumToString(code, aString);
  124.             aString := Concat('Signal caught from main, code = ',aString,
  125.                 ', registerLong = ');
  126.             DoCatchOutMain(aString, registerLong);
  127.         END;
  128.         
  129.         registerLong := $FFFF;
  130.         
  131.         Signal(Value);
  132.     END; {Main}
  133.     
  134. BEGIN {PROGRAM}
  135.     InitSignals; {Call this with other (i.e. toolbox) inits}
  136.     Main;
  137. END.
  138.